home *** CD-ROM | disk | FTP | other *** search
/ Video Toaster 4.2 / Video Toaster v4.2.iso / arexx / modeler / procalc.lwm < prev    next >
Text File  |  1993-12-13  |  8KB  |  357 lines
  1. /* CMD: ProCalc Chart
  2.  * ProCalc.lwm -- Work with Spreadsheet data from Gold Disk's
  3.  * "Professional Calc" in Modeler
  4.  * By Arnie Cachelin Copyright © 1992, 1993 NewTek, Inc.
  5.  * Sun May 30 1993 */
  6.  
  7. call addlib "LWModelerARexx.port", 0
  8. signal on error
  9. signal on syntax
  10. options results
  11.  
  12. if ~show('P',"PCALC") then do
  13.   notify(1,"!Can't find ProCalc...","Is it running?")
  14.   exit
  15.   end
  16. ADDRESS "PCALC"
  17.  
  18. cellcmd.1="call MakeBlock "cell","||x||","||y||","||z
  19. cellcmd.3="call MakePlane "cell","||x||","||yold||","||z||","||y
  20. cellcmd.2="call MakePlaneBlock "col||row","||x||","||yold||","||z||","||y
  21. /* Use above for flat plane chart type */
  22.  
  23. /* To Do:
  24.   1) make a big flat base poly for bar charts, possibly with Grid texture
  25.   2) scale bar chart base to match max height (?)
  26.   3) add other chart types:
  27.       a) Area plot
  28.       b) Pie chart
  29.  
  30. */
  31.  
  32. call req_begin 'ProCalc Chart'
  33.  
  34. /* id_nsx = req_addcontrol("X Segments", 'n') */
  35. /* id_nsy = req_addcontrol("Y Segments", 'n') */
  36. id_reg = req_addcontrol("Cells: ", 'CH',"Selected All")
  37. id_typ = req_addcontrol("Chart Type: ","CH","Bar Line Pie Area")
  38.  
  39. /* call req_setval id_nsx, nsx, 20 */
  40. /* call req_setval id_nsy, nsy, 20 */
  41. call req_setval id_reg, 1
  42. call req_setval id_typ, 1
  43.  
  44. if (~req_post()) then do
  45.     call req_end
  46.     exit
  47. end
  48.  
  49. /* NSX = req_getval(id_nsx) % 1 */
  50. /* NSY = req_getval(id_nsx) % 1 */
  51. typ   = req_getval(id_typ)
  52. reg = req_getval(id_reg)
  53.  
  54. call req_end
  55.  
  56. BlockMarg=.2
  57. BlockWidth=1-BlockMarg
  58.  
  59. DrawMessage "This is a message from ARexx."
  60. Current
  61. crange=result
  62. parse var crange firstcell':'lastcell
  63. if lastcell="" then do
  64.   call notify(1,"!Select a range first")
  65.   DrawMessage  "Select a range first"
  66.   exit
  67. end
  68.  
  69. if typ=3 then do
  70.   call Pie()
  71.   selectrange crange
  72.   exit
  73.   end
  74.  
  75. if reg=1 then do
  76.   if typ<3 then say ProcessRange(cellcmd.typ)
  77.   else say AreaRange()
  78.   end
  79. else
  80.   if typ<3 then say ProcessAll(cellcmd.typ)
  81.   else say AreaAll()
  82. selectrange crange
  83. exit
  84.  
  85. syntax:
  86. error:
  87.   call end_all
  88.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  89.     exit
  90.  
  91. MakeBlock:    PROCEDURE    EXPOSE BlockMarg BlockWidth
  92.     arg cell,x,y,z
  93.      call Surface(cell)
  94.     call Makebox(x+BlockMarg 0 z+BlockMarg,x+BlockWidth y z+BlockWidth)
  95.     return(1)
  96.  
  97.  
  98. MakePlane:    PROCEDURE    EXPOSE BlockMarg BlockWidth
  99.     arg cell,x,y,z,y2
  100.     say x y z cell blockmarg BlockWidth
  101.      call Surface(cell)
  102.   call add_begin
  103.   call add_point  x  y  z
  104.   call add_point  x+BlockWidth+BlockMarg  y  z
  105.   call add_point  x+BlockWidth+BlockMarg  y2  z+BlockWidth+BlockMarg
  106.   call add_point x y2 z+BlockWidth+BlockMarg
  107.   call add_polygon 4 3 2 1
  108.   call add_end
  109.     return(1)
  110.  
  111. MakePlaneBlock:    PROCEDURE    EXPOSE BlockMarg BlockWidth
  112.     arg cell,x,y,z,y2
  113.     say x y z cell blockmarg BlockWidth
  114.      call Surface(cell)
  115.   call add_begin
  116.   call add_point x y z
  117.   call add_point x+BlockWidth+BlockMarg  y  z
  118.   call add_point x+BlockWidth+BlockMarg  y2 z+BlockWidth+BlockMarg
  119.   call add_point x y2 z+BlockWidth+BlockMarg
  120.   call add_point x 0 z
  121.   call add_point x+BlockWidth+BlockMarg 0 z
  122.   call add_point x+BlockWidth+BlockMarg 0 z+BlockWidth+BlockMarg
  123.   call add_point x 0 z+BlockWidth+BlockMarg
  124.   call add_polygon 4 3 2 1
  125.   call add_polygon 5 6 7 8
  126.   call add_polygon 1 5 8 4
  127.   call add_polygon 4 8 7 3
  128.   call add_polygon 2 3 7 6
  129.   call add_polygon 1 2 6 5
  130.   call add_end
  131.     return(1)
  132.  
  133.  /* Execute cmd on each cell in current range */
  134. ProcessRange:    PROCEDURE EXPOSE BlockMarg BlockWidth
  135.   arg cmd
  136.     Current
  137.     crange=result
  138.   parse var crange firstcell':'lastcell
  139.     if lastcell="" then return(0)
  140.     say crange", "firstcell", "lastcell
  141.     c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
  142.     firstrow=substr(firstcell,c)
  143.     firstcol=left(firstcell,c-1)
  144.     c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
  145.     lastrow=substr(lastcell,c)
  146.     lastcol=left(lastcell,c-1)
  147.     i=0
  148.     xmax=c2d(lastcol)-c2d(firstcol)
  149.     zmax=lastrow-firstrow
  150.     say "Rows "firstrow" to "lastrow" Span: "zmax
  151.     say "Cols "firstcol" to "lastcol" Span: "xmax
  152.     do col_num=c2d(firstcol) to c2d(lastcol)
  153.         col=d2c(col_num)
  154.         x=col_num-c2d(firstcol)
  155.         do row=firstrow to lastrow
  156.             z=row-firstrow
  157.             cell=col||row
  158.             SelectCell cell
  159.             GetValue
  160.       yold=y
  161.             y=Result
  162.       if yold="Y" then yold=y
  163.              say cmd
  164.             if y~="" then interpret cmd
  165.             i=i+1
  166.     end
  167.   end
  168.     return i
  169.  
  170. AreaRange:    PROCEDURE
  171.     Current
  172.     crange=result
  173.   parse var crange firstcell':'lastcell
  174.     if lastcell="" then return(0)
  175.     say crange", "firstcell", "lastcell
  176.     c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
  177.     firstrow=substr(firstcell,c)
  178.     firstcol=left(firstcell,c-1)
  179.     c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
  180.     lastrow=substr(lastcell,c)
  181.     lastcol=left(lastcell,c-1)
  182.     i=0
  183.     xmax=c2d(lastcol)-c2d(firstcol)
  184.     zmax=lastrow-firstrow
  185.     say "Rows "firstrow" to "lastrow" Span: "zmax
  186.     say "Cols "firstcol" to "lastcol" Span: "xmax
  187.   call add_begin
  188.     do col_num=c2d(firstcol) to c2d(lastcol)
  189.         col=d2c(col_num)
  190.         x=col_num-c2d(firstcol)
  191.         do row=firstrow to lastrow
  192.             z=row-firstrow
  193.             cell=col||row
  194.             SelectCell cell
  195.             GetValue
  196.             y=Result
  197.             if y~="" then do
  198.         vec = x y z
  199.         call add_point(vec)
  200.                i=i+1
  201.         end
  202.     end
  203.   end
  204.   i=1
  205.     do col_num=c2d(firstcol) to c2d(lastcol)-1
  206.         col=d2c(col_num)
  207.         x=col_num-c2d(firstcol)
  208.         do row=firstrow to lastrow
  209.             z=row-firstrow
  210.             cell=col||row
  211.             SelectCell cell
  212.             call Surface(cell)
  213.             GetValue
  214.             y=Result
  215.             if y~="" then do
  216.         if i//(zmax+1)>0 then do
  217.           call add_quad i i+zmax+1 i+zmax+2 i+1
  218.           end
  219.              i=i+1
  220.       end
  221.     end
  222.   end
  223.   call add_end
  224.     return i
  225.  
  226. Pie:    PROCEDURE
  227.     Current
  228.     crange=result
  229.   parse var crange firstcell':'lastcell
  230.     if lastcell="" then return(0)
  231.     say crange", "firstcell", "lastcell
  232.     c=verify(firstcell,"0123456789","M") /* Position of first numeric digit */
  233.     firstrow=substr(firstcell,c)
  234.     firstcol=left(firstcell,c-1)
  235.     c=verify(lastcell,"0123456789","M") /* Position of first numeric digit */
  236.     lastrow=substr(lastcell,c)
  237.     lastcol=left(lastcell,c-1)
  238.     do row=firstrow to lastrow
  239.     total.row=0
  240.       do col_num=c2d(firstcol) to c2d(lastcol)
  241.           col=d2c(col_num)
  242.             cell=col||row
  243.             SelectCell cell
  244.             GetValue
  245.             y=Result
  246.             if y~="" then total.row=total.row + y
  247.     end
  248.   end
  249.   do row=firstrow to lastrow
  250.       do col_num=c2d(firstcol) to c2d(lastcol)
  251.           col=d2c(col_num)
  252.             cell=col||row
  253.             SelectCell cell
  254.             call Surface(cell)
  255.             GetValue
  256.             y=Result
  257.             if y~="" then call AddWedge(360*y/total.row)
  258.       end
  259.     if row~=lastrow then call move(0 1 0)
  260.     end
  261.     return i
  262.  
  263.  
  264. ProcessAll:    PROCEDURE EXPOSE BlockMarg BlockWidth
  265.   arg cmd
  266.     firstrow='A'
  267.     firstcol='1'
  268.     GetLastRow
  269.     lastrow=result
  270.     GetLastCol
  271.     lastcol=result
  272.     i=0
  273.     xmax=c2d(lastcol)-c2d(firstcol)
  274.     zmax=lastrow-firstrow
  275.     say "Rows "firstrow" to "lastrow" Span: "zmax
  276.     say "Cols "firstcol" to "lastcol" Span: "xmax
  277.     do col_num=c2d(firstcol) to c2d(lastcol)
  278.         col=d2c(col_num)
  279.         x=col_num-c2d(firstcol)
  280.         do row=firstrow to lastrow
  281.             z=row-firstrow
  282.             cell=col||row
  283.             SelectCell cell
  284.             GetValue
  285.       yold=y
  286.             y=Result
  287.       if yold="Y" then yold=y
  288.             if y~="" then interpret cmd
  289.             i=i+1
  290.     end
  291.   end
  292.     return i
  293.  
  294. AreaAll:    PROCEDURE EXPOSE BlockMarg BlockWidth
  295.     firstrow='A'
  296.     firstcol='1'
  297.     GetLastRow
  298.     lastrow=result
  299.     GetLastCol
  300.     lastcol=result
  301.     i=0
  302.     xmax=c2d(lastcol)-c2d(firstcol)
  303.     zmax=lastrow-firstrow
  304.     say "Rows "firstrow" to "lastrow" Span: "zmax
  305.     say "Cols "firstcol" to "lastcol" Span: "xmax
  306.   call add_begin
  307.     do col_num=c2d(firstcol) to c2d(lastcol)
  308.         col=d2c(col_num)
  309.         x=col_num-c2d(firstcol)
  310.         do row=firstrow to lastrow
  311.             z=row-firstrow
  312.             cell=col||row
  313.             SelectCell cell
  314.             GetValue
  315.             y=Result
  316.             if y~="" then do
  317.         vec = x y z
  318.         call add_point(vec)
  319.                i=i+1
  320.         end
  321.     end
  322.   end
  323.   i=1
  324.     do col_num=c2d(firstcol) to c2d(lastcol)-1
  325.         col=d2c(col_num)
  326.         x=col_num-c2d(firstcol)
  327.         do row=firstrow to lastrow
  328.             z=row-firstrow
  329.             cell=col||row
  330.             SelectCell cell
  331.             call Surface(cell)
  332.             GetValue
  333.             y=Result
  334.             if y~="" then do
  335.         if i//(zmax+1)>0 then do
  336.           call add_quad i i+zmax+1 i+zmax+2 i+1
  337.           end
  338.              i=i+1
  339.       end
  340.     end
  341.   end
  342.   call add_end
  343.     return i
  344.  
  345. MakeWedge: PROCEDURE /* It should be easy to make a more efficient curve wedge */
  346.   arg ang,rad
  347.   call makebox(0,rad rad/2 0 )
  348.   call lathe('Y',(ang%5)+1,0,ang,0) /* Make segs constant to morph slices */
  349.   return ang
  350.  
  351. AddWedge: PROCEDURE
  352.   arg ang
  353.   call rotate(ang,'Y')
  354.   call Cut()
  355.   call makewedge(ang,1)
  356.   call paste()
  357.   return ang